Shareware Overload Trio 2/Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO/dir31/gusutils.zip/GUSDUMP.PAS

Pascal/Delphi Source File | 1994-02-08 | 5KB | 193 lines

(****************************************************************************)
(* Module     : GUSDUMP.PAS                                                 *)
(* Verion     : 0.3ß                                                        *)
(* Date       : Thu Feb 3, 1994                                             *)
(* Pascal     : TP 7.0                                                      *)
(****************************************************************************)
(*                                                                          *)
(* NOTICE OF COPYRIGHT AND OWNERSHIP OF SOFTWARE:                           *)
(*                                                                          *)
(* Portions Copyright (C) 1993, 1994 by MESS Computer Services.             *)
(* Copyright (C) 1993, 1994 by TBP Electronics Ltd.                         *)
(* All rights reserved.                                                     *)
(*                                                                          *)
(****************************************************************************)
(* MESS Computer Services V.O.F.        MM   MM  EEEEEE   SSSSS   SSSSS     *)
(* Jadestraat 54                        M M M M  E       S       S          *)
(* 4817 JK  Breda                       M  M  M  EEEE     SSSS    SSSS      *)
(* The Netherlands                      M     M  E            S       S     *)
(*                                      M     M  EEEEEE  SSSSS   SSSSS      *)
(* Tel: [phone]                                                     *)
(* Fax: [phone]               Many Efforts for Structured Systems   *)
(* Email: [e-mail]                                            *)
(****************************************************************************)


{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
{$M 4096,0,0}

Program GUSDump;
{
  dumps memory form a ultrasound card on the screen
    possible parameters are
        0 - fffff   hex start location
    -x          hex dump
    -l          number of lines
    default start location is 0
    default number of lines is 16
}

uses
    dos,
    gus,
    crt;

const
    Hex : array [0..15] of Char = '0123456789ABCDEF';

var
    Teller  ,
    Tel2    : Word;
    Value   : Byte;       { read value from dram }
    Start   : LongInt;    { start of dump }
    Dhex    : Boolean;    { display hex or chars }
    Fault   : Boolean;    { fault occured, 0 = no fault, 1 = parameters, }
    Lines   ,             { number of lines }
    Col     : Word;       { number of colums on screen }

{ ---------------------- }

function HexAdd (L : LongInt) : String;
var
    St : String;
begin
    St := '00000';

    St[1] := Hex[L and $F0000 shr 16];
    St[2] := Hex[L and $0F000 shr 12];
    St[3] := Hex[L and $00F00 shr  8];
    St[4] := Hex[L and $000F0 shr  4];
    St[5] := Hex[L and $0000F shr  0];

    HexAdd := St;
end;

{ ------------------ }

function HexByte (B : Byte) : String;
var
    St : String;
begin
    St := '00';

    St[1] := Hex[B and $000F0 shr  4];
    St[2] := Hex[B and $0000F shr  0];

    HexByte := St;
end;

{ ------------------ }

procedure evalparm;
var
    Tel      ,
    Tel1     ,
    Tel2     : word;
    Eigen    : string;
    First    : boolean;
begin
    First := True;
    for Tel := 1 to ParamCount do
    begin
        Eigen := ParamStr(tel);
        for Tel1 := 1 to Length(Eigen) do
            Eigen[Tel1] := UpCase(Eigen[Tel1]);
        if (Eigen[1] = '-') and (Eigen[2] = 'L') then
        begin
            { count lines }
            Delete(Eigen,1,2);
            Val(Eigen, Lines, Lines);
            if Lines <> 0
                then DEC(Lines)
                else Lines := 16;
        end
            else
        begin
            if (Eigen = '-X') then Dhex := True
                else
            begin
                if (NOT(Fault) and First) then
                begin
                    First := False;
                    Eigen := '$' + Eigen;
                    Val (Eigen, Start, Tel2);
                    if (Start > $FFFFF) then Start := -1;
                    if (Start > $FFFFF - 1215) then Start := $FFFFF - 1215;
                end
                    else
                Fault := True;
        end; end; end;
end;

{ ------------------------ }

begin
    clrscr;
    WriteLn ('Gravis UltraSound Memory Dump     v0.3ß');
    WriteLn ('(C)CopyRight 1993-1994, TBP Electronics');
    writeln;

    Dhex   := False;
    Fault  := False;
    Lines  := 16;
    Start  := 0;

    evalparm;

    if Dhex then
        Col := 16
    else
        Col := 64;

    if MegaEm then
    begin
        WriteLn ('Mega-Em from Jayeson Lee-Steere is active, sorry cant read GUS DRAM');
    end else begin

    IF Fault then
    begin
        WriteLn ('Usage : GUSDUMP  [hex start address 0 - FFFFF] [-X] [-L#]');
    end else begin

    If Dhex then
    begin
            WriteLn ('        0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F');
    end
        else
    begin
        WriteLn ('       0               1               2               3');
        WriteLn ('       0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF');
    end;

    for Teller := 0 to lines do
    begin
        Write ( HexAdd(start + (teller * col)) );
        Write ('  ');
        for tel2 := 0 to col -1 do
        begin
            value := Guspeek(Start + (teller * col) + tel2);
            if Dhex then
            begin
                write(HexByte(value), ' ');
            end
                else
            begin
                if (value > 31)
                    then write(chr(value))
                    else write(' ');
            end;
        end;
    writeln;
    end; end; end;
end.